home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / comm / eac102.zip / DEMO / UNIT2.PAS < prev   
Pascal/Delphi Source File  |  1997-01-21  |  6KB  |  219 lines
  1. unit Unit2;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Buttons, ExtCtrls, clipbrd, enhavicap, vfw;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Edit1: TEdit;
  12.     Label1: TLabel;
  13.     Label2: TLabel;
  14.     ListBox1: TListBox;
  15.     BitBtn2: TBitBtn;
  16.     BitBtn3: TBitBtn;
  17.     scaled: TCheckBox;
  18.     BitBtn4: TBitBtn;
  19.     BitBtn5: TBitBtn;
  20.     BitBtn6: TBitBtn;
  21.     preview: TCheckBox;
  22.     Label3: TLabel;
  23.     DlgCompression: TBitBtn;
  24.     DlgDisplay: TBitBtn;
  25.     DlgFormat: TBitBtn;
  26.     DlgSource: TBitBtn;
  27.     RadioGroup1: TRadioGroup;
  28.     Label4: TLabel;
  29.     Label5: TLabel;
  30.     Label6: TLabel;
  31.     video: TEnhAVICap;
  32.     img: TImage;
  33.     Label7: TLabel;
  34.     Label8: TLabel;
  35.     procedure BitBtn2Click(Sender: TObject);
  36.     procedure ListBox1DblClick(Sender: TObject);
  37.     procedure BitBtn3Click(Sender: TObject);
  38.     procedure previewClick(Sender: TObject);
  39.     procedure scaledClick(Sender: TObject);
  40.     procedure BitBtn4Click(Sender: TObject);
  41.     procedure BitBtn6Click(Sender: TObject);
  42.     procedure BitBtn5Click(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure DlgCompressionClick(Sender: TObject);
  45.     procedure DlgDisplayClick(Sender: TObject);
  46.     procedure DlgFormatClick(Sender: TObject);
  47.     procedure DlgSourceClick(Sender: TObject);
  48.     procedure RadioGroup1Click(Sender: TObject);
  49.     procedure videoFrame(Sender: TObject; h: Integer; VHdr: PVideoHdr);
  50.   private
  51.     { Private declarations }
  52.     w:integer;
  53.     h:integer;
  54.     caps:TCapDriverCaps;
  55.   public
  56.     { Public declarations }
  57.   end;
  58.  
  59. var Form1:TForm1;
  60.  
  61. implementation
  62.  
  63. {$R *.DFM}
  64.  
  65. function FrameCallBack(AWnd:HWnd;lpVHdr:PVideoHdr):longint; stdcall;
  66. var BmpHead:PBitmapInfo;
  67.     h      :THandle;
  68.     punt   :pointer;
  69. begin
  70. GetMem(BmpHead,CapGetVideoFormatSize(AWnd));
  71. CapGetVideoFormat(AWnd,BmpHead,sizeof(TBitmapInfoHeader));
  72. form1.label3.caption:=format('%4.4s %d %d',[PChar(@(BmpHead.bmiHeader.biCompression)),
  73.                                             lpVHdr.dwBufferLength,
  74.                                             lpVHdr.dwBytesUsed]);
  75. BmpHead.bmiHeader.biSizeImage:=lpVHdr.dwBytesUsed;
  76. h:=ICImageDecompress(0,0,BmpHead,lpVHdr.lpData,nil);
  77. if h<>0 then                      
  78.   begin
  79.   punt:=GlobalLock(h);
  80.   SetDIBits(form1.img.canvas.handle,form1.img.picture.bitmap.handle,
  81.             0,BmpHead.bmiHeader.biHeight,
  82.             pointer(longint(punt)+PBitmapInfoHeader(punt).biSize),
  83.             PBitmapInfo(punt)^,
  84.             DIB_RGB_COLORS);
  85.   GlobalUnlock(h);
  86.   GlobalFree(h);
  87.   form1.img.repaint;
  88.   end;
  89. FreeMem(BmpHead,CapGetVideoFormatSize(AWnd));
  90. result:=1;
  91. end;  { FrameCallBack }
  92.  
  93. procedure TForm1.BitBtn2Click(Sender: TObject);
  94. var BmpHead:TBitmapInfo;
  95. begin
  96. if ListBox1.ItemIndex<>-1 then
  97.   begin
  98.   video.OpenVideo(ListBox1.ItemIndex);
  99.   if video.IsOpen then
  100.     begin
  101.     CapGetVideoFormat(video.CapWnd,@BmpHead,sizeof(BmpHead));
  102.     img.picture.bitmap.width :=BmpHead.bmiHeader.biWidth ;
  103.     img.picture.bitmap.height:=BmpHead.bmiHeader.biHeight;
  104.     end;  { if }
  105.   end;  { if }
  106. end;
  107.  
  108. procedure TForm1.ListBox1DblClick(Sender: TObject);
  109. var BmpHead:TBitmapInfo;
  110. begin
  111. if ListBox1.ItemIndex<>-1 then
  112.   begin
  113.   video.ConnectDriver(ListBox1.ItemIndex);
  114.   if video.IsOpen then
  115.     begin
  116.     CapGetVideoFormat(video.CapWnd,@BmpHead,sizeof(BmpHead));
  117.     img.picture.bitmap.width :=BmpHead.bmiHeader.biWidth ;
  118.     img.picture.bitmap.height:=BmpHead.bmiHeader.biHeight;
  119.     end;  { if }
  120.   end;  { if }
  121. end;
  122.  
  123. procedure TForm1.BitBtn3Click(Sender: TObject);
  124. begin
  125. video.CloseVideo;
  126. end;
  127.  
  128. procedure TForm1.previewClick(Sender: TObject);
  129. begin
  130. if preview.checked then
  131.   video.preview:=true
  132. else
  133.   video.overlay:=true;
  134. end;
  135.  
  136. procedure TForm1.scaledClick(Sender: TObject);
  137. begin
  138. video.PreviewScaled:=scaled.checked;
  139. end;
  140.  
  141. procedure TForm1.BitBtn4Click(Sender: TObject);
  142. begin
  143. if video.ToClipboard then
  144.   img.picture.assign(clipboard);
  145. end;
  146.  
  147. procedure TForm1.BitBtn6Click(Sender: TObject);
  148. begin
  149. video.CaptureStart('c:\avitest.avi');
  150. end;
  151.  
  152. procedure TForm1.BitBtn5Click(Sender: TObject);
  153. begin
  154. video.CaptureStop;
  155. end;
  156.  
  157. procedure TForm1.FormCreate(Sender: TObject);
  158. var x:integer;
  159. begin
  160. edit1.text:=video.VFWVersion;
  161. for x:=0 to video.CapDrivers.count-1 do
  162.   ListBox1.items.add(format('%d - %s',[x,video.CapDrivers.strings[x]]));
  163. ListBox1.ItemIndex:=0;
  164. if video.width <>160 then video.width :=160;
  165. if video.height<>120 then video.height:=120;
  166. img.left:=video.left+video.width+16;
  167. form1.height:=video.top+video.height+video.left+
  168.               GetSystemMetrics(SM_CYDLGFRAME)*2+GetSystemMetrics(SM_CYCAPTION);
  169. end;
  170.  
  171. procedure TForm1.DlgCompressionClick(Sender: TObject);
  172. begin
  173. if video.DlgCompression then MessageBeep(0);
  174. end;
  175.  
  176. procedure TForm1.DlgDisplayClick(Sender: TObject);
  177. begin
  178. if video.DlgDisplay then MessageBeep(0);
  179. end;
  180.  
  181. procedure TForm1.DlgFormatClick(Sender: TObject);
  182. begin
  183. if video.DlgFormat then MessageBeep(0);
  184. end;
  185.  
  186. procedure TForm1.DlgSourceClick(Sender: TObject);
  187. begin
  188. if video.DlgSource then MessageBeep(0);
  189. end;
  190.  
  191. procedure TForm1.RadioGroup1Click(Sender: TObject);
  192. begin
  193. case RadioGroup1.ItemIndex of
  194.   0 : begin
  195.       video.preview:=false;
  196.       video.overlay:=false;
  197.       end;
  198.   1 : video.preview:=true;
  199.   2 : video.overlay:=true;
  200.   end;  { case }
  201. end;
  202.  
  203. procedure TForm1.videoFrame(Sender: TObject; h: Integer; VHdr: PVideoHdr);
  204. var punt:pointer;
  205. begin
  206. form1.label3.caption:=format('%d %d',[VHdr.dwBufferLength,
  207.                                       VHdr.dwBytesUsed]);
  208. punt:=GlobalLock(h);
  209. SetDIBits(img.canvas.handle,img.picture.bitmap.handle,
  210.           0,PBitmapInfoHeader(punt).biHeight,
  211.           pointer(longint(punt)+PBitmapInfoHeader(punt).biSize),
  212.           PBitmapInfo(punt)^,
  213.           DIB_RGB_COLORS);
  214. GlobalUnlock(h);
  215. img.repaint;
  216. end;
  217.  
  218. end.
  219.